home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-kerberos.el.z / efs-kerberos.el
Encoding:
Text File  |  1998-05-21  |  4.8 KB  |  137 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-kerberos.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.0 $
  7. ;; RCS:
  8. ;; Description:  Support for Kerberos gateways.
  9. ;; Author:       Sandy Rutherford <sandy@gandalf.sissa.it>
  10. ;; Created:      Thu Nov 24 21:19:25 1994 by sandy on gandalf
  11. ;; Modified:
  12. ;;
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14.  
  15. ;;; Support for the Kerberos gateway authentication system from MIT's
  16. ;;; Project Athena.
  17.  
  18. (provide 'efs-kerberos)
  19. (require 'efs)
  20.  
  21. (defconst efs-kerberos-version
  22.   (concat (substring "$efs release: 1.15 $" 14 -2)
  23.       "/"
  24.       (substring "#Revision: 1.0 $" 11 -2)))
  25.  
  26. ;;; Internal Variables
  27.  
  28. (defvar efs-kerberos-passwd-sent nil)
  29. ;; Set to t after the passwd has been sent.
  30. (defvar efs-kerberos-output "")
  31. ;; Holds the output lines from the kinit process.
  32. (defvar efs-kerberos-buffer-name "*efs kerberos*")
  33. ;; Buffer where kinit output is logged.
  34. (defvar efs-kerberos-passwd-prompt-regexp "^Password: *$")
  35. ;; Regular expression to match prompt used by the kinit program.
  36. (defvar efs-kerberos-failed-msgs "[^ ]+")
  37. ;; Regular expression to match output for an invalid kinit ticket password.
  38. ;; Is this too general?
  39. (defvar efs-kerberos-passwd-failed nil)
  40. ;; Whether the kinit command worked.
  41. (defvar efs-kerberos-passwd-retry nil)
  42.  
  43. ;;; Code
  44.  
  45. (defun efs-kerberos-process-filter (proc str)
  46.   ;; Process filter for the kinit process.
  47.   (setq efs-kerberos-output (concat efs-kerberos-output str))
  48.   (let ((buff (get-buffer (process-buffer proc))))
  49.     (if buff
  50.     (efs-save-buffer-excursion
  51.       (set-buffer buff)
  52.       (efs-save-match-data
  53.         (goto-char (point-max))
  54.         (while (string-match "\n" efs-kerberos-output)
  55.           (let ((line (substring efs-kerberos-output 0
  56.                      (match-beginning 0))))
  57.         (insert line "\n")
  58.         (and efs-kerberos-passwd-sent
  59.              (string-match efs-kerberos-failed-msgs line)
  60.              (setq efs-kerberos-passwd-failed t)))
  61.           (setq efs-kerberos-output (substring efs-kerberos-output
  62.                            (match-end 0))))
  63.         (and (null efs-kerberos-passwd-sent)
  64.          (string-match efs-kerberos-passwd-prompt-regexp
  65.                    efs-kerberos-output)
  66.          (memq (process-status proc) '(run open))
  67.          (let ((passwd (or
  68.                 (efs-lookup-passwd efs-gateway-host "kerberos")
  69.                 (read-passwd
  70.                  (if efs-kerberos-passwd-retry
  71.                      "Password failed.  Try again: "
  72.                    (format "Kerberos password for %s: "
  73.                        efs-gateway-host))))))
  74.            (unwind-protect
  75.                (progn
  76.              (insert efs-kerberos-output)
  77.              (setq efs-kerberos-output "")
  78.              (process-send-string proc passwd)
  79.              (insert "Turtle Power!\n"))
  80.              (fillarray passwd 0)))))))))
  81.  
  82. (defun efs-kerberos-get-ticket ()
  83.   ;; Gets a kerbos ticket.  The password is actually sent by the process
  84.   ;; filter.
  85.   (let ((mess (format "Getting kerberos ticket for %s..." efs-gateway-host)))
  86.     (message mess)
  87.     (setq efs-kerberos-passwd-failed nil
  88.       efs-kerberos-passwd-sent nil
  89.       efs-kerberos-output "")
  90.     (condition-case nil (delete-process "*efs kerberos*") (eror nil))
  91.     (let* ((program (or (nth 3 efs-gateway-type) "kinit"))
  92.        (args (nth 4 efs-gateway-type))
  93.        (proc (apply 'start-process
  94.             "*efs kerberos*" efs-kerberos-buffer-name
  95.             program args)))
  96.       (set-process-filter proc (function efs-kerberos-process-filter))
  97.       ;; Should check for a pty, but efs-pty-check will potentially eat
  98.       ;; important output.  Need to wait until Emacs 19.29 to do this properly.
  99.       (while (memq (process-status proc) '(run open))
  100.     (accept-process-output proc))
  101.       (if efs-kerberos-passwd-failed
  102.       (let ((efs-kerberos-passwd-failed t))
  103.         (efs-kerberos-get-ticket))))
  104.     (message "%sdone" mess)))
  105.  
  106. (defun efs-kerberos-login (host user proc)
  107.   ;; Open a connection using process PROC to HOST adn USER, using a
  108.   ;; kerberos gateway.  Returns the process object of the connection.
  109.   ;; This may not be PROC, if a ticket collection was necessary.
  110.   (let ((to host)
  111.     result port cmd)
  112.     (if (string-match "#" host)
  113.     (setq to (substring host 0 (match-beginning 0))
  114.           port (substring host (match-end 0))))
  115.     (and efs-nslookup-on-connect
  116.      (string-match "[^0-9.]" to)
  117.      (setq to (efs-nslookup-host to)))
  118.     (setq cmd (concat "open " to))
  119.     (if port (setq cmd (concat cmd " " port)))
  120.     (setq result (efs-raw-send-cmd proc cmd))
  121.     (while (and (car result)
  122.         (string-match "\\bcannot authenticate to server\\b"
  123.                   (nth 1 result)))
  124.       (let ((name (process-name proc)))
  125.     (condition-case nil (delete-process proc) (error nil))
  126.     (efs-kerberos-get-ticket)
  127.     (setq proc (efs-start-process host user name)
  128.           result (efs-raw-send-cmd proc cmd))))
  129.     (if (car result)
  130.     (progn
  131.       (condition-case nil (delete-process proc) (error nil))
  132.       (efs-error host user (concat "OPEN request failed: "
  133.                        (nth 1 result)))))
  134.     proc))
  135.  
  136. ;;; End of efs-kerberos.el
  137.